home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
os2
/
lxlt115.zip
/
SOURCES
/
UNLOCK.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1996-06-14
|
5KB
|
200 lines
uses os2base, miscUtil, Helpers, strOp, Crt, Dos;
const Version = '1.0.1';
Recurse : boolean = _OFF;
Pause : boolean = _OFF;
Verbose : boolean = _ON;
var OldExit : Procedure;
fNames : pDarray;
allDone : boolean;
Procedure Stop(eCode : Byte);
begin
case eCode of
1,2 : begin
if eCode = 2
then begin
TextAttr := $0C;
Writeln('├ Invalid switch - see help below for details');
end;
TextAttr := $07;
Writeln('├ Usage: unLock [FileMask1] {...FileMask2} {/EPVH?}');
Writeln('├ /E{+|-} r[E]cursive (+) file search through subdirectories');
Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
Writeln('├ /V{+|-} Verbose (show a lot of additional information)');
Writeln('├ /?,/H Show this help screen');
Writeln('├┤Default: /E- /P- /V+');
TextAttr := $08;
Writeln('└┤Example: unLock d:\*.exe d:\*.dll /e');
end;
end;
Halt(eCode);
end;
Function ParmHandler(var S : string) : Byte;
var I : Longint;
Function Enabled : boolean;
begin
Enabled := _ON;
if length(S) = 1
then exit
else
if (S[2] in ['+','-'])
then ParmHandler := 2
else
if (S[2] in [' ','/'])
then exit
else Stop(2);
if S[2] = '-' then Enabled := _OFF;
end;
begin
ParmHandler := 1;
case upCase(S[1]) of
'?',
'H' : Stop(1);
'E' : Recurse := Enabled;
'P' : Pause := Enabled;
'V' : Verbose := Enabled;
else Stop(2);
end;
end;
Function NameHandler(var S : string) : Byte;
var I : Longint;
Quote : boolean;
begin
I := 0;
if S[1] = '"' then begin Quote := _ON; Delete(S, 1, 1); end else Quote := _OFF;
While (I < length(S)) and ((S[succ(I)] > ' ') or Quote) do
if Quote and (S[succ(I)] = '"')
then break
else Inc(I);
fNames^.AddItem(NewStr(Copy(S, 1, I)));
Inc(I, byte(Quote));
NameHandler := I;
end;
Procedure MyExitProc;
begin
Write(#13);
TextAttr := $07; ClrEOL;
OldExit;
end;
Function Ask(const Q,A : string) : byte;
var ch : char;
begin
TextAttr := $02;
Write('└ ', Q, ' ');
repeat
ch := upCase(ReadKey);
if First(ch, A) <> 0
then begin
Ask := First(ch, A);
break;
end;
until _OFF;
Writeln(Ch,#13'├');
end;
Procedure ProcessFile(fName : string);
var _d : DirStr;
_n : NameStr;
_e : ExtStr;
F : File;
Procedure NotLocked;
begin
if Verbose
then begin Write(' not locked'); textAttr := $0B; Writeln(#13'├'); end
else begin Write(#13); ClrEOL; end;
end;
begin
if length(fName) >= 255 then exit;
fSplit(fName, _d, _n, _e);
textAttr := $0B; ClrEOL; Write('└ Processing file ', Copy(_n + _e, 1, 28));
FileMode := open_share_DenyReadWrite or open_access_ReadOnly;
Assign(F, fName); Reset(F, 1);
if ioResult = 0
then begin
Close(F); NotLocked;
Exit;
end;
fName[succ(length(fName))] := #0; Inc(byte(fName[0]));
case DosReplaceModule(@fName[1], nil, nil) of
0 : begin
textAttr := $0A; Write(' unlocked');
textAttr := $0B; Writeln(#13'├');
end;
2 : NotLocked;
else begin
textAttr := $0C; Write(' sharing violation');
textAttr := $0B; Writeln(#13'├');
end
end;
end;
Procedure ProcessFiles(const fN : string; Level : Longint);
var sr : SearchRec;
_d : DirStr;
_n : NameStr;
_e : ExtStr;
nf : Longint;
begin
fSplit(fN, _d, _n, _e);
FindFirst(fN, Archive or Hidden or SysFile, sr);
if (DosError <> 0) and (Level = 0) and (not Recurse)
then begin
textAttr := $0C;
Writeln('├ Cannot find such files: ', fN);
end;
nf := 0;
While (DosError = 0) and (not allDone) do
begin
if Pause
then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
2 : sr.Name := '';
3 : begin allDone := _ON; break; end;
end;
if (sr.Name <> '') then ProcessFile(_d + sr.Name);
FindNext(sr);
end;
FindClose(sr);
if allDone or not Recurse then Exit;
if nf = 0 then begin textAttr := $0B; Write('└ ', _d); ClrEOL; Write(#13); end;
FindFirst(_d + '*.*', Archive or Hidden or SysFile or Directory, sr);
While (dosError = 0) and (not allDone) do
begin
if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.')
then ProcessFiles(_d + sr.Name + '\' + _n + _e, succ(Level));
FindNext(sr);
end;
FindClose(sr);
end;
var I : Longint;
begin
TextAttr := $0F;
Writeln('┌[ unLock ]──────────────────────────────[ Version '+Version+' ]┐');
Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
TextAttr := $07;
@OldExit := ExitProc; ExitProc := @MyExitProc;
New(fNames, Init(8));
ParseCommandLine(#0, ParmHandler, NameHandler);
if (fNames^.numItems = 0) then Stop(1);
For I := 1 to fNames^.numItems do
begin
ProcessFiles(pString(fNames^.GetItem(I))^, 0);
if allDone then break;
end;
TextAttr := $01; ClrEOL;
Writeln('└┤Done');
end.